;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; Created on 2008-06-27 21:58:39

(in-package :jacolib)


;
; logs & conditions
;

(cl-log:defcategory :authentication-error)
(cl-log:defcategory :authentication-info)

;
; Authentication functions
;

(defun authenticate-connection (stream secret-string)
  (declare (type stream stream))
  (let ((auth-type (authentication-read-simple-string stream)))
    (cond
     ((string-equal auth-type "none")
      t)
     ((string-equal auth-type "plain")
      (authentication-write-simple-string stream secret-string))
     ((string-equal auth-type "md5")
      (let* ((randomstring (authentication-read-simple-string stream))
             (md5 (generate-md5-string randomstring secret-string)))
        (authentication-write-simple-string stream md5)))
      (t
       nil))
    (let* ((hello nil))
      (setf hello (authentication-read-simple-string stream))
      (cond 
       ((string-equal hello "correct")
        t)
       ((string-equal hello "incorrect")
        nil)
       (t
        (error 'protocol-error :message "correct or incorrect string was expected"))))))
    
(defun ask-connection-authentication (stream auth-type secret-string)
  (declare (type stream stream))
  (cl-log:log-message :authentication-info "auth: ~A ~A" auth-type secret-string)
  (let ((ok nil))
    (cond
     ((equal :none auth-type)
      (authentication-write-simple-string stream "none")
      (setf ok t))
     ((equal :plain auth-type)
      (let ((passwd nil))
        (authentication-write-simple-string stream "plain")
        (setf passwd (authentication-read-simple-string stream))
        (setf ok (string-equal passwd secret-string))))
     ((equal :md5 auth-type)
      (let ((randomstring (generate-random-string))
            (md5 nil))
        (authentication-write-simple-string stream "md5")
        (authentication-write-simple-string stream randomstring)
        (setq md5 (authentication-read-simple-string stream))
        (setf ok (string-equal md5 (generate-md5-string randomstring secret-string)))))
     (t 
      (setf ok nil)))
    (if ok
        (progn
          (authentication-write-simple-string stream "correct")
          t)
        (progn
          (authentication-write-simple-string stream "incorrect")
          nil))))

(defun authentication-write-simple-string (stream str)
  (declare (type stream stream))
  (cl-log:log-message :authentication-info "write: ~A" str)
  (format stream "~A~%" str)
  (force-output stream))

(defun authentication-read-simple-string (stream)
  (declare (type stream stream))
  (let ((data (read-line stream)))
    (cl-log:log-message :authentication-info "read: ~A" data)
    data))


; generate md5 from the random string and the secret

(defun generate-md5-string (randomstr secret)
  (declare (type string randomstr)
           (type string secret))
  (progn
    (char-vector->string 
     (md5:md5sum-sequence
      (concatenate 'string secret randomstr)))))


; convert a vector of chars into a string

(defun char-vector->string(seq)
   (format nil "~{~(~2,'0X~)~}" (map 'list #'(lambda (x) x) seq)))


; generate a random string

(defvar codes '(
                     #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
                     #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
                     #\~ #\! #\# #\$ #\% #\^ #\& #\* #\( #\) #\- #\= #\+ #\, #\. #\/ #\;
                     #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
                     ))

(defun generate-random-string (&optional (len 16))
  (let ((ret (make-string len)))
    (dotimes (x len)
      (setf (schar ret x) (nth (random (length codes)) codes)))
    ret))

